unit encoding;

interface

uses
  bson;

//
// Check that a field name is valid UTF8, does not start with a '$',
// and contains no '.' characters. Set bson bit field appropriately.
// Note that we don't need to check for '\0' because we're using
// strlen(3), which stops at '\0'.
//
// @param b The bson object to which field name will be appended.
// @param string The field name as char*.
// @param length The length of the field name.
//
// @return BSON_OK if valid UTF8 and BSON_ERROR if not. All BSON strings must be
//     valid UTF8. This function will also check whether the string
//     contains '.' or starts with '$', since the validity of this depends on context.
//     Set the value of b->err appropriately.
//
function bson_check_field_name(var b: TBson; str: PAnsiChar; length: Integer): Integer;

//
// Check that a string is valid UTF8. Sets the buffer bit field appropriately.
//
// @param b The bson object to which string will be appended.
// @param string The string to check.
// @param length The length of the string.
//
// @return BSON_OK if valid UTF-8; otherwise, BSON_ERROR.
//     Sets b->err on error.
//
function bson_check_string(var b: TBson; str: PAnsiChar; length: Integer): Integer;

implementation

const
  trailingBytesForUTF8: array[AnsiChar] of Byte = (
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5
  );

// ---------------------------------------------------------------------

//
// Utility routine to tell whether a sequence of bytes is legal UTF-8.
// This must be called with the length pre-determined by the first byte.
// The length can be set by:
//  length = trailingBytesForUTF8[*source]+1;
// and the sequence is illegal right away if there aren't that many bytes
// available.
// If presented with a length > 4, this returns 0.  The Unicode
// definition of UTF-8 goes up to 4-byte sequences.
//
function isLegalUTF8(source: PAnsiChar; length: Integer): Boolean;
var
  srcptr: PAnsiChar;
begin
  Result := False;
  srcptr := source + length;
  if (length < 1) or (length > 4) then Exit;
  if length = 4 then begin
    Dec(srcptr);
    if (srcptr^ < #$80) or (srcptr^ > #$BF) then Exit;
  end;
  if length >= 3 then begin
    Dec(srcptr);
    if (srcptr^ < #$80) or (srcptr^ > #$BF) then Exit;
  end;
  if length >= 2 then begin
    Dec(srcptr);
    if srcptr^ > #$BF then Exit;
    case source^ of
      #$E0: if srcptr^ < #$A0 then Exit;
      #$F0: if srcptr^ < #$90 then Exit;
      #$F4: if srcptr^ > #$8F then Exit;
    else
      if srcptr^ < #$80 then Exit;
    end;
  end;
  if length >= 1 then begin
    if (source^ >= #$80) and (source^ <= #$C2) then Exit;
    if source^ > #$F4 then Exit;
  end;
  Result := True;
end;

function bson_validate_string(var b: TBson; str: PAnsiChar; length: Integer; check_utf8,
  check_dot, check_dollar: Boolean): Integer;
var
  position,
  sequence_length: Integer;
begin
  position := 0;
  sequence_length := 1;
  if check_dollar and (str[0] = '$') then
    Include(b.err, bvfBsonFieldInitDollar);

  while position < length do begin
    if check_dot and (str[position] = '.') then
      Include(b.err, bvfBsonFieldHasDot);

    if check_utf8 then begin
      sequence_length := trailingBytesForUTF8[str[position]] + 1;
      if (position + sequence_length) > length then begin
        Include(b.err, bvfBsonNotUtf8);
        Exit(BSON_ERROR);
      end;
      if not isLegalUTF8(str + position, sequence_length) then begin
        Include(b.err, bvfBsonNotUtf8);
        Exit(BSON_ERROR);
      end;
    end;
    Inc(position, sequence_length);
  end;
  Result := BSON_OK;
end;

function bson_check_field_name(var b: TBson; str: PAnsiChar; length: Integer): Integer;
begin
  Result := bson_validate_string(b, str, length, True, True, True);
end;

function bson_check_string(var b: TBson; str: PAnsiChar; length: Integer): Integer;
begin
  Result := bson_validate_string(b, str, length, True, False, False);
end;

end.
